home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / wgdb-42.lha / wgdb-4.2 / gdb / lisp.c < prev    next >
C/C++ Source or Header  |  1992-09-11  |  6KB  |  304 lines
  1. /* Changes to track when merging:
  2.    Changes in stack.c to support backtrace changes
  3.    Changes in infrun to support .o loading
  4.    add lisp.c and lisp.o to Makefile.in
  5.    Modify top-level README
  6.    maybe symtab.c if we fix that stuff.
  7.    dbxread.c: remove no debug symbols found msg.
  8. */
  9.  
  10. #include <string.h>
  11. #include <stdio.h> 
  12. #include "defs.h"
  13. #include "param.h"
  14. #include "frame.h"
  15. #include "symtab.h"
  16. #include "value.h"
  17. #include "expression.h"
  18. #include "gdbcore.h"
  19. #include "gdbcmd.h"
  20. #include "target.h"
  21.  
  22. extern char *xmalloc ();
  23.  
  24. #define CHAR_TO_NUMBER(c) ((c <= '9') ? c - '0' : c + 10 - 'A')
  25.  
  26. int lisp_name_p(name)
  27.      char* name;
  28. {
  29.   return((name != NULL) &&
  30.      (strchr("pmsvftb",*name) != NULL) &&
  31.      (*(name + 1) == '_'));
  32. }
  33.  
  34. char hex_to_ascii(hex)
  35.      char* hex;
  36. {
  37.   return((CHAR_TO_NUMBER(hex[0]) * 16) + CHAR_TO_NUMBER(hex[1]));
  38. }  
  39.  
  40. void print_lisp_name(name)
  41.      char* name;
  42. {
  43.   char c;
  44.  
  45.   c = *name;
  46.   name = name + 2;
  47.   if (strchr("spm",c) != NULL) {
  48.     name = strchr(name,'_');
  49.     if (name == NULL) {
  50.       printf("Lisp naming error: no package found\n");
  51.     }
  52.     name = name + 1;
  53.   }
  54.   c = *name;
  55.   while (c != '\0') {
  56.     if (c == '_') {
  57.       c = hex_to_ascii(name + 1);
  58.       putchar(c);
  59.       name = name + 3; 
  60.     } else {
  61.       putchar(c);
  62.       name = name + 1;
  63.     }
  64.     c = *name;
  65.   }
  66. }
  67.  
  68. char *lisp_demangle(name)
  69.      char *name;
  70. {
  71.   char c,*new,*tmp;
  72.  
  73.   if (lisp_name_p(name)) {
  74.     new = (char *) xmalloc(strlen(name));
  75.     tmp = new;
  76.     c = *name;
  77.     name = name + 2;
  78.     if (strchr("spm",c) != NULL) {
  79.       name = strchr(name,'_');
  80.       if (name == NULL) {
  81.     printf("Lisp naming error: no package found\n");
  82.     return(NULL);
  83.       }
  84.       name = name + 1;
  85.     }
  86.     c = *name;
  87.     while (c != '\0') {
  88.       if (c == '_') {
  89.     c = hex_to_ascii(name + 1);
  90.     *tmp = c;
  91.     tmp = tmp + 1;
  92.     name = name + 3; 
  93.       } else {
  94.     *tmp = c;
  95.     tmp = tmp + 1;
  96.     name = name + 1;
  97.       }
  98.       c = *name;
  99.     }
  100.     *tmp = 0;
  101.     return(new);
  102.   } else {
  103.     return(NULL);
  104.   }
  105. }
  106.  
  107. lisp_strcmp(mangled,normal)
  108.       char* mangled; char* normal;
  109. {
  110.   return(strcmp(mangled,normal));
  111.   if ((((*mangled ==  'v')  ||(*mangled == 'p')) && (*(mangled + 1) == '_')) &&
  112.       (*mangled != *normal)) {
  113.     printf("lisp_strcmp: %s to %s\n",mangled,normal);
  114.     if (*mangled == 'v') {
  115.       mangled = mangled + 2;    /*  skip: v_ */
  116.     } else {
  117.       mangled = mangled + 6;    /*  skip: p_pkg_ */
  118.     }
  119.     while ((*normal != NULL) && (*mangled != NULL))  {
  120.       if (toupper(*normal) == *mangled) {
  121.     normal = normal + 1;
  122.     mangled = mangled + 1;
  123.       } else {
  124.     if ((*mangled == '_') && (*normal == hex_to_ascii(mangled + 1))) {
  125.       normal = normal + 1;
  126.       mangled = mangled + 3;
  127.     } else {
  128.       return(strcmp(mangled,normal));
  129.     }
  130.       }
  131.     }
  132.     if (*mangled == '_') {
  133.       mangled = mangled + 1;
  134.       /*  skip trialing number or return false if other stuff */
  135.       while (*mangled != NULL) {
  136.     if (isdigit(*mangled)) {
  137.       mangled = mangled + 1;
  138.     } else {
  139.       break;
  140.     }
  141.       }
  142.     }
  143.   }
  144.   return(strcmp(mangled,normal));
  145. }
  146.  
  147. char* hidden_lisp_frames[] = { "apply_function", "apply_function_1", NULL };
  148.  
  149. int find_special_frame_entry(function_name)
  150.      char* function_name;
  151. {
  152.   if ((function_name != NULL) &&
  153.       (strcmp(function_name,"eval_closure_code")) == 0) {
  154.     return(1);
  155.   } else {
  156.     return(0);
  157.   }
  158. } 
  159.  
  160. print_special_lisp_frame(index)
  161.      int index;
  162. {
  163.   fflush(stdout);
  164.   /* This relies on the selected_frame being correct */
  165.   parse_and_eval("p_lsp_GDBBACKTRACE(1,name)",1);
  166.   fprintf_filtered(stdout," (interpreted)"); 
  167. }
  168.  
  169. int hide_frames = 1;
  170.  
  171. static void
  172. hide_command(exp)
  173.      char* exp;
  174. {
  175.   hide_frames = ((hide_frames == 0) ? 1 : 0);
  176. }
  177.  
  178.  
  179. hidden_lisp_frame_p(function_name)
  180.      char* function_name;
  181. {
  182.   int i;
  183.  
  184.   if (hide_frames && (function_name != NULL)) {
  185.     /* Hide all eval frames except function calls. */
  186.     if (((strstr(function_name,"p_lsp_EVAL_")) != 0) &&
  187.     (find_special_frame_entry(function_name) == 0)) {
  188.       return(1);
  189.     } else {
  190.       for (i = 0; (hidden_lisp_frames[i] != NULL); i = i + 1) {
  191.     if (strcmp(hidden_lisp_frames[i],function_name)  == 0) {
  192.       return(1);
  193.     }
  194.       }
  195.     }
  196.   }
  197.   return(0);
  198. }
  199.  
  200. static void
  201. lprint_command(exp)
  202.      char* exp;
  203. {
  204.   char buffer[1024];
  205.  
  206.   sprintf(buffer,"p_lsp_GDBPRINT(1,%s)",exp);
  207.   parse_and_eval(buffer,1);
  208. }
  209.  
  210. static void
  211. leval_command(exp)
  212.      char* exp;
  213. {
  214.   char *addr_exp;
  215.   FRAME frame;
  216.   struct frame_info *fi;
  217.   struct symbol *func;
  218.   char *funname = 0;
  219.   extern FRAME parse_frame_specification ();
  220.   extern int so_list_head;    /* lie... */
  221.  
  222.   if (so_list_head == 0) {
  223.     printf("Issue the sharedlib library command before using eval.\n");
  224.   } else {
  225.     char buffer[1024];
  226.  
  227.     frame = parse_frame_specification (addr_exp);
  228.     fi = get_frame_info (frame);
  229.     func = get_frame_function (frame);
  230.     if (exp == 0) {
  231.       exp = "0";
  232.     }
  233.     if (func == 0 || (find_special_frame_entry(SYMBOL_NAME(func)) == 0)) {
  234.       sprintf(buffer,"p_lsp_NULLEVALDEBUG(1,%s) \0",exp);
  235.     } else {
  236.       sprintf(buffer,"p_lsp_EVALDEBUG(7, %s, name, evaled_args, venv, fenv, tenv, benv) \0",exp);
  237.     }
  238.     parse_and_eval(buffer,1);
  239.   }
  240. }
  241.  
  242.  
  243. static void
  244. lisp_abort_command (arg, from_tty)
  245.      char *arg;
  246.      int from_tty;
  247. {
  248.   extern int so_list_head;    /* lie... */
  249.   if (so_list_head == 0) {
  250.     printf("Issue the sharedlib library command before using abort.\n");
  251.   } else {
  252.     printf("Aborting to top-level\n");
  253.     jump_command("abort_to_top_level",from_tty);
  254.   }
  255. }
  256.  
  257.  
  258. static void
  259. lisp_restart_command (arg, from_tty)
  260.      char *arg;
  261.      int from_tty;
  262. {
  263.   extern int so_list_head;    /* lie... */
  264.  
  265.   int n = -1;
  266.   if (arg) {
  267.     n = parse_and_eval_address(arg);
  268.   }
  269.   if (so_list_head == 0) {
  270.     printf("Issue the sharedlib library command before using restart.\n");
  271.   } else {
  272.     printf("Restarting\n");
  273.     jump_command("select_restart_option",from_tty);
  274.   }
  275. }
  276.  
  277. static void
  278. restart_info (exp, from_tty)
  279.      char *exp;
  280.      int from_tty;
  281. {
  282.   parse_and_eval("p_lsp_SHOW_2DRESTARTS(0)");
  283. }
  284.  
  285.  
  286. _initialize_lisp ()
  287. {
  288.   add_com ("hide", class_vars, hide_command,"Hide some stack frames");
  289.  
  290.   add_com ("lp", class_vars, lprint_command,"Call Lisp Printer");
  291.  
  292.   add_com ("eval", class_vars, leval_command,
  293.            "Call Lisp Interpreter with current frame's environment");
  294.  
  295.   add_com ("abort", class_run, lisp_abort_command,
  296.        "Abort to top-level");
  297.  
  298.   add_com ("restart", class_run, lisp_restart_command,
  299.        "Select a restart option");
  300.  
  301.   add_info("restarts", restart_info, "Show available restart options");
  302. }
  303.  
  304.